home *** CD-ROM | disk | FTP | other *** search
/ SPACE 2 / SPACE - Library 2 - Volume 1.iso / music / 7 / modula / cube.mod next >
Text File  |  1985-11-19  |  5KB  |  186 lines
  1.  
  2. IMPLEMENTATION MODULE Cube;
  3.  
  4. (* throw up a rotating cube on the Atari 520 ST --- Chris Hall, 1985 *)
  5. (* (c) TDI Software Ltd. 1985 Released by permission Les Caudle *)
  6.  
  7. FROM GEMVDIbase IMPORT
  8.      (* types *) VDIWorkInType, VDIWorkOutType ;
  9.  
  10. FROM VDIControls IMPORT
  11.      (* procs *) OpenVirtualWorkstation, CloseVirtualWorkstation ;
  12.  
  13. FROM VDIOutputs IMPORT
  14.      (* procs *) PolyLine ;
  15.  
  16. FROM VDIAttribs IMPORT
  17.      (* procs *) SetWritingMode, SetColour;
  18.  
  19. FROM AESGraphics IMPORT
  20.      (* procs *) GrafHandle;
  21.  
  22.  
  23. CONST lines      = 12;     (* a cube has 12 lines *)
  24.       vertices   = 8;      (* and eight corners   *)
  25.       maxNoLines = 100;
  26.       distance   = 2000.0; (* viewing distance    *)
  27.       addingX    = 160.0;  (* for centering image was 320 for mono *)
  28.       addingY    = 100.0;  (* was 200 for mono  *)
  29.       sinphi     = (* sin (PI/16) *) 0.195090322;
  30.       cosphi     = (* cos (PI/16) *) 0.980785280;
  31.  
  32. TYPE LineSegment  = ARRAY [0..3] OF INTEGER;
  33.      PolyLineType = ARRAY [1..lines] OF LineSegment;
  34.  
  35. VAR start,
  36.     finish     : ARRAY [1..lines]    OF CARDINAL;
  37.     x, y, z    : ARRAY [1..vertices] OF REAL;
  38.     x2d, y2d   : ARRAY [1..vertices] OF INTEGER;
  39.     whichArray : BOOLEAN;
  40.     polyLine   : ARRAY BOOLEAN OF PolyLineType;
  41.  
  42.  
  43. PROCEDURE XRotation;
  44.  
  45. VAR i    : CARDINAL;
  46.     Y, Z : REAL;
  47.  
  48. BEGIN
  49.   FOR i := 1 TO vertices DO
  50.     Y := y [i]; Z := z [i];
  51.     y [i] := Y * cosphi - Z * sinphi;
  52.     z [i] := Z * cosphi + Y * sinphi;
  53.   END; (* FOR *)
  54. END XRotation;
  55.  
  56.  
  57. PROCEDURE YRotation;
  58.  
  59. VAR i    : CARDINAL;
  60.     X, Z : REAL;
  61.  
  62. BEGIN
  63.   FOR i := 1 TO vertices DO
  64.     X := x [i]; Z := z [i];
  65.     x [i] := X * cosphi - Z * sinphi;
  66.     z [i] := Z * cosphi + X * sinphi;
  67.   END; (* FOR *)
  68. END YRotation;
  69.  
  70.  
  71. PROCEDURE ZRotation;
  72.  
  73. VAR i    : CARDINAL;
  74.     X, Y : REAL;
  75.  
  76. BEGIN
  77.   FOR i := 1 TO vertices DO
  78.     X := x [i]; Y := y [i];
  79.     x [i] := X * cosphi - Y * sinphi;
  80.     y [i] := Y * cosphi + X * sinphi;
  81.   END; (* FOR *)
  82. END ZRotation;
  83.  
  84.  
  85. PROCEDURE DrawShape;
  86.  
  87. VAR i : INTEGER;
  88.     d : BOOLEAN;
  89.  
  90. BEGIN
  91.   d := NOT whichArray;
  92.   FOR i := 1 TO lines DO
  93.     polyLine [whichArray, i, 0] := x2d [start[i]];
  94.     polyLine [whichArray, i, 1] := y2d [start[i]];
  95.     polyLine [whichArray, i, 2] := x2d [finish[i]];
  96.     polyLine [whichArray, i, 3] := y2d [finish[i]];
  97.     PolyLine (handle, 2, polyLine [whichArray, i]);  (* draw new cube *)
  98.     PolyLine (handle, 2, polyLine [d, i]);           (* undraw old cube *)
  99.   END; (*FOR *)
  100.   whichArray := NOT whichArray;
  101. END DrawShape;
  102.  
  103.  
  104. PROCEDURE ConvertToXYpairs;
  105.  
  106. VAR i : CARDINAL;
  107.     f : REAL;
  108.  
  109. BEGIN
  110.   FOR i := 1 TO vertices DO
  111.     f := 1000.0 / (distance - z [i]);
  112.     x2d [i] := INTEGER(TRUNC( x [i] * f + addingX ));
  113.     y2d [i] := INTEGER(TRUNC( y [i] * f + addingY ));
  114.   END; (* FOR *)
  115. END ConvertToXYpairs;
  116.  
  117.  
  118. PROCEDURE SetPoints; (* put points into array *)
  119.  
  120. BEGIN
  121.   x [1] := -75.0; y [1] :=  75.0; z [1] :=  75.0;
  122.   x [2] :=  75.0; y [2] :=  75.0; z [2] :=  75.0;
  123.   x [3] :=  75.0; y [3] := -75.0; z [3] :=  75.0;
  124.   x [4] := -75.0; y [4] := -75.0; z [4] :=  75.0;
  125.   x [5] := -75.0; y [5] :=  75.0; z [5] := -75.0;
  126.   x [6] :=  75.0; y [6] :=  75.0; z [6] := -75.0;
  127.   x [7] :=  75.0; y [7] := -75.0; z [7] := -75.0;
  128.   x [8] := -75.0; y [8] := -75.0; z [8] := -75.0;
  129. END SetPoints;
  130.  
  131.  
  132. PROCEDURE SetLines;
  133.  
  134. BEGIN
  135.   start [1]  := 1; finish [1]  := 2;
  136.   start [2]  := 2; finish [2]  := 3;
  137.   start [3]  := 3; finish [3]  := 4;
  138.   start [4]  := 4; finish [4]  := 1;
  139.   start [5]  := 1; finish [5]  := 5;
  140.   start [6]  := 2; finish [6]  := 6;
  141.   start [7]  := 3; finish [7]  := 7;
  142.   start [8]  := 4; finish [8]  := 8;
  143.   start [9]  := 5; finish [9]  := 6;
  144.   start [10] := 6; finish [10] := 7;
  145.   start [11] := 7; finish [11] := 8;
  146.   start [12] := 8; finish [12] := 5;
  147. END SetLines;
  148.  
  149. VAR c, d   : CARDINAL;
  150.     b      : BOOLEAN;
  151.     j      : INTEGER;
  152.     handle : INTEGER;
  153.     In     : VDIWorkInType;
  154.     Out    : VDIWorkOutType;
  155.  
  156. PROCEDURE DoCube ;
  157. BEGIN 
  158.   FOR c := 0 TO 9 DO In [c] := 1 END;
  159.   In [10] := 2;
  160.   handle := GrafHandle (j, j, j, j);
  161.   OpenVirtualWorkstation (In, handle, Out);
  162.   j := SetWritingMode (handle, 3);
  163.   FOR b := FALSE TO TRUE DO
  164.     FOR c := 1 TO lines DO
  165.       FOR d := 0 TO 3 DO
  166.         polyLine [b, c, d] := 0
  167.       END;
  168.     END;
  169.   END;
  170.   whichArray := FALSE;
  171.   SetPoints;
  172.   SetLines;
  173.   FOR c := 1 TO 2 DO
  174.     YRotation;
  175.     ZRotation;
  176.     END; (* FOR *)
  177.   FOR c := 1 TO 1000 DO
  178.     XRotation;
  179.     ConvertToXYpairs;
  180.     DrawShape;
  181.   END;
  182.   CloseVirtualWorkstation (handle);
  183. END DoCube ;
  184.  
  185. END Cube.
  186. əəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəə